Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE08/TASBVLVE/TASBVLVE.ZIP/tasbvlve.pas

Pascal/Delphi Source File | 1996-03-12 | 8.5 KB | 290 lines

unit TASBvlve;
(**************************************************************************
TASBoolValve class
==================
A VCL which implements a binary state pipe valve.  (Binary state as opposed
to a real valve where the state of the valve is measured as a percentage
of fully open.)

Data type TValveState is used to indicate if valve is open (vsOpen)
or shut (vsShut).

Author:  Stewart McSporran
E-Mail:  [e-mail]
Date  :  19/6/95
Copyright ⌐1995-96 Ascendant Software

Amendments
----------
10/3/96  OnChange event added

Licence
=======
Since I have picked up many useful freeware components I have decided to
release this one as freeware as a way of saying thanks.

I still retain copyright to this product, but you may use it in any application
you write (commercial or otherwise) without payment to me.  If you amend this
component then please leave this comment block in the amended source code.

If you do decide to use this component then please drop me a note.  (We all
need our egos massaged from time to time!)

Advert
======
If you have need of a Delphi programmer (teleworking) then please drop me
a line.  Rates are negotiable.

1 year's experience with Delphi.  3 years C++ (Yeuch!).  BSc Computing Science
Co-authorship "Developing Object Oriented Data Structures in C++", McGraw-Hill
Ex Naval Officer.

(I'm currently working as a research assistant, but who wants to work for
others when there's the chance of working for yourself?)
**************************************************************************)

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  {Possible states of a valve}
  TValveState = (vsOpen, vsShut);
  {Possible orientations of the valve}
  TValveOrientation = ( voHorizontal, voVertical );

  {Need an event handler type for the on change event}
  TValveChangeEvent = procedure (Sender : TObject; NewState :TValveState; var AllowChange : boolean) of object;

  TASBoolValve = class(TGraphicControl)
  private
    FState : TValveState;    {State of control (open or shut)}
    FPen : TPen;             {Colour of lines}
    FBrush : TBrush;         {Colour of lever}
    FOrientation : TValveOrientation;     {horizontal or vertical component}
    FOnChange : TValveChangeEvent;
    {Property write procedures}
    procedure SetState(val : TValveState);
    procedure SetPen(val : TPen);
    procedure SetBrush(val : TBrush);
    procedure SetOrientation(val : TValveOrientation);
    {Called when pen or brush is changed to redraw object}
    procedure StyleChanged(Sender : TObject);
  protected
    procedure Paint; override;
    procedure Click; override;
    {Add OnChange event - NewState: State valve will enter if user allows change
                          AllowChange: Set to false to stop valve changing}
    procedure Change(Sender : TObject; NewState :TValveState; var AllowChange : boolean); dynamic;
    {Draws the valve actuator lever at the angle specified.
    Angle measured in degrees 0=shut .. 90=open}
    procedure DrawLever( angle : integer);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Pen : TPen read FPen write SetPen;
    property Brush : TBrush read FBrush write SetBrush;
    property State : TValveState read FState write SetState default vsShut;
    property Orientation : TValveOrientation read FOrientation write SetOrientation;
    property OnClick;
    property OnChange : TValveChangeEvent read FOnChange write FOnChange;
    property ParentShowHint;
    property ShowHint;
    property Visible;
  end;

procedure Register;

implementation

constructor TASBoolValve.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FState := vsShut;
  Width := 24;
  Height := 18;
  FBrush := TBrush.Create;
  FBrush.Style := bsSolid;
  FBrush.Color := clRed;
  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush.OnChange := StyleChanged;
end;

destructor TASBoolValve.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  inherited Destroy;
end;

procedure TASBoolValve.SetState(val : TValveState);
begin
  if FState <> val then
  begin
    FState := val;
    Refresh;
  end;
end;

procedure TASBoolValve.SetPen(val : TPen);
begin
  FPen.Assign(val);
end;

procedure TASBoolValve.SetBrush(val : TBrush);
begin
  FBrush.Assign(val);
end;

procedure TASBoolValve.SetOrientation(val : TValveOrientation);
begin
  if FOrientation <> val then
  begin
    FOrientation := val;
    {Swap over the width and height, this re-draws the component}
    SetBounds(Left,Top,Height,Width);
  end;
end;

{Just re-draw the component}
procedure TASBoolValve.StyleChanged(Sender : TObject);
begin
  Invalidate;
end;

{For maximum speed this should really be drawn into a separate canvas and
then copied onto the screen - but this is fast enough.}
procedure TASBoolValve.Paint;
var
  uDim : integer;   {The unit size for the drawing}
  x1, x2, y1, y2 : integer;
begin
  with Canvas do
  begin
    Pen.Assign(FPen);
    Brush.Assign(FBrush);
    if FOrientation = voHorizontal then
    begin
      uDim := Height div 3;
      {Draw basic shape   |><| }
      MoveTo(0,uDim);
      LineTo(0,Height-1);              {|  }
      LineTo(Width-1,uDim);            { / }
      LineTo(Width-1,Height-1);        {  |}
      LineTo(0,uDim);                  { \ }
      {Draw circle in centre}
      x1 := Width div 2 - uDim div 2;
      y1 := uDim + uDim div 2;
      x2 := x1 + uDim;
      y2 := y1 + uDim;
      Ellipse(x1,y1,x2,y2);
      {Now draw lever}
      if FState = vsShut then
        DrawLever(90)
      else
        DrawLever(180);
    end else begin    {orientation = vertical}
      uDim := Width div 3;
      {Draw basic shape   |><| }
      MoveTo(0,0);
      LineTo(Width-uDim,0);              { - }
      LineTo(0,Height-1);                { / }
      LineTo(Width-uDim,Height-1);       { - }
      LineTo(0,0);                       { \ }
      {Draw circle in centre}
      x1 := uDim div 2;
      y1 := Height div 2 - uDim div 2;
      x2 := x1 + uDim;
      y2 := y1 + uDim;
      Ellipse(x1,y1,x2,y2);
      {Now draw lever}
      if FState = vsShut then
        DrawLever(0)
      else
        DrawLever(90);
    end;
  end;
end;

(**************************************************************************
TASBoolValve DrawLever method
Draws the valve actuator lever at the angle specified.
Angle measured in degrees 0=shut .. 90=open
**************************************************************************)
procedure TASBoolValve.DrawLever( angle : integer);
var
  rAngle, phi, dx, dy : extended;
  x, y, uDim, p1x, p1y, p2x, p2y : integer;
  cX, cY : integer;
begin
  {convert angle to radians}
  rAngle := angle * Pi / 180.0;
  if FOrientation = voHorizontal then
  begin
    {Calculate unit dimension (as for Paint)}
    uDim := Height div 3;
    {Get position of lever end (model lever as straight line here)}
    cX := Width div 2;     {centre of circle}
    cY := Height - uDim - 1;
  end else begin
    uDim := Width div 3;
    {Get position of lever end (model lever as straight line here)}
    cX := uDim;     {centre of circle}
    cY := Height div 2;
  end;
  x := trunc(cX + 2 * uDim * cos(rAngle));
  y := trunc(2 * uDim - 2 * uDim * sin(rAngle));
  {Now calculate points at edges of lever}
  phi := pi / 2 - rAngle;
  dx := (uDim div 3) * cos(phi);
  dy := (uDim div 3) * sin(phi);
  p1x := round(x + dx);
  p1y := round(y + dy);
  p2x := round(x - dx);
  p2y := round(y - dy);
  {right, let's draw the polygon}
  Canvas.Pen.Color := FBrush.Color;
  Canvas.Polygon([Point(cX,cY),Point(p1x,p1y),Point(p2x,p2y),
                  Point(cX,cY)]);
end;

procedure TASBoolValve.Click;
var
  AllowChange : boolean;
  NewState : TValveState;
begin
  if FState = vsOpen then
    NewState := vsShut
  else
    NewState := vsOpen;
  AllowChange := True;
  {Initiate OnChange event}
  Change(Self,NewState,AllowChange);
  {Respond to AllowChange state}
  if AllowChange then
  begin
    FState := NewState;
    Repaint;
  end;
  inherited Click;
end;

procedure TASBoolValve.Change(Sender : TObject; NewState :TValveState;
                                     var AllowChange : boolean);
begin
  {Call user's event handler, if it exists}
  if Assigned(FOnChange) then
    FOnChange(Sender,NewState,AllowChange);
end;

procedure Register;
begin
  RegisterComponents('Ascendant', [TASBoolValve]);
end;

end.